home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #2
/
Monster Media No. 2 (Monster Media)(1994).ISO
/
os2
/
pds105.zip
/
SNAKE2.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-03-09
|
21KB
|
840 lines
/*REXX*/
signal on HALT name HaltExit
/***
signal on ERROR name ErrorExit
signal on FAILURE name FailureExit
signal on SYNTAX name SyntaxExit
***/
main:
parse arg p1
sGlobal.iMaxR = 25
sGlobal.iMaxC = 80
sGlobal.fDebug = 'N'
sGlobal.fRetain = 'N'
sGlobal.fInitChar = ' '
sGlobal.sInitChar = ' '
sGlobal.i1Row = 1
sGlobal.i1Col = 1
sGlobal.i2Row = sGlobal.iMaxR
sGlobal.i2Col = sGlobal.iMaxC
sGlobal.fCollide = 'N'
sGlobal.fHome = 'N'
sGlobal.fCollision = 'N'
sGlobal.fBackHome = 'N'
sGlobal.fBeepTrail = 'N'
sGlobal.fBeepHeads = 'N'
sGlobal.fBeepWalls = 'N'
sGlobal.fBeepHome = 'N'
sGlobal.xTrailer = 'B0'x
fInit ='N'
fDebug = 'N'
fDispStax= 'N'
fDispHelp= 'N'
fRetainQ = 'N'
fInitCHQ = 'N'
sInitCH = ' '
fInitRow1Q = 'N'
iInitRow1 = sGlobal.i1Row
fInitCol1Q = 'N'
iInitCol1 = sGlobal.i1Col
fInitRow2Q = 'N'
iInitRow2 = sGlobal.i2Row
fInitCol2Q = 'N'
iInitCol2 = sGlobal.i2Col
fCollideQ = sGlobal.fCollide
fHomeQ = sGlobal.fHome
fBeepTrailQ = sGlobal.fBeepTrail
fBeepHeadsQ = sGlobal.fBeepHeads
fBeepWallsQ = sGlobal.fBeepWalls
fBeepHomeQ = sGlobal.fBeepHome
CALL rParseParms p1
if fDebug = 'Y' then
do
trace ?r
end
if fDispStax = 'Y' then
do
CALL rDispSyntax 0, 0
end
if fDispHelp = 'Y' then
do
CALL rDispSyntax 1, 0
end
/* Actual routine */
rc = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
if rc <> 0 then
do
Call rSiren 1, 1
say 'SNAKE2 - Unable to initialize the "RXPD" subsystem'
exit 8
end
sGlobal.iMaxR = 25
sGlobal.iMaxC = 80
sGlobal.fDebug=fDebug
sGlobal.fRetain=fRetainQ
sGlobal.fInitChar=fInitCHQ
sGlobal.sInitChar=sInitCH
sGlobal.i1Row=iInitRow1
sGlobal.i1Col=iInitCol1
sGlobal.i2Row=iInitRow2
sGlobal.i2Col=iInitCol2
sGlobal.fCollide=fCollideQ
sGlobal.fHome=fHomeQ
sGlobal.fBeepTrail=fBeepTrailQ
sGlobal.fBeepHeads=fBeepHeadsQ
sGlobal.fBeepWalls=fBeepWallsQ
sGlobal.fBeepHome =fBeepHomeQ
sGlobal.sBid = rxPDInit('SNAKE2','GREENHI','RED','REDHI',,25,80)
if sGlobal.sBid = x2c(00000000) then
do
Call rSiren 2, 3
say 'SNAKE2 - Error to initializing the "RXPD" subsystem'
exit 8
end
fInit ='Y'
Call rxPDZVarDefine
fAttr1 = ZVTYPE_LONG+ZVTYPE_RIGHTADJUST+ZVTYPE_LZEROFILL
fAttr2 = ZVTYPE_DOUBLE+ZVTYPE_RIGHTADJUST+ZVTYPE_LZEROFILL
Call rxPDVarDefine sGlobal.sBid, 'sGlobal.row.1', fAttr1
Call rxPDVarDefine sGlobal.sBid, 'sGlobal.col.1', fAttr1
Call rxPDVarDefine sGlobal.sBid, 'sGlobal.row.5', fAttr1
Call rxPDVarDefine sGlobal.sBid, 'sGlobal.col.5', fAttr1
Call rxPDVarDefine sGlobal.sBid, 'iESecs', fAttr2, 3
do i = 1 to sGlobal.iMaxR
sRow.i = LEFT(sGlobal.sInitChar,sGlobal.iMaxC,sGlobal.sInitChar)
end /* do i = 1 to sGlobal.iMaxR */
akey = rxPDDisplay(sGlobal.sBid,'PANEL000')
do while 0 = rDoBOUNCE(sGlobal.sBid)
end /* do while 0 = rDoBOUNCE() */
rc = rxPDTerm(sGlobal.sBid)
exit 0
/**********************************************************************\
rDoBOUNCE:
This routine displays a dialog panel that bounces a ball
\**********************************************************************/
rDoBOUNCE:
parse arg sGlobal.sBid
/* Determine direction of sprite # 1*/
if sGlobal.i1Row < sGlobal.iMaxR-4 then /* Bottom part of display */
do
i1RD = +1
end
else
do
i1RD = -1
end
if sGlobal.i1Col < sGlobal.iMaxC-4 then /* Left side of display */
do
i1CD = +1
end
else
do
i1CD = -1
end
/* Initialize Sprite # 1 */
sGlobal.row.4 = sGlobal.i1Row
sGlobal.col.4 = sGlobal.i1Col
sGlobal.rd.4 = i1RD
sGlobal.cd.4 = i1CD
sGlobal.x.4 = 'B0'x
sGlobal.row.3 = sGlobal.row.4 + i1RD
sGlobal.col.3 = sGlobal.col.4 + i1CD
sGlobal.rd.3 = i1RD
sGlobal.cd.3 = i1CD
sGlobal.x.3 = 'B1'x
sGlobal.row.2 = sGlobal.row.3 + i1RD
sGlobal.col.2 = sGlobal.col.3 + i1CD
sGlobal.rd.2 = i1RD
sGlobal.cd.2 = i1CD
sGlobal.x.2 = 'B2'x
sGlobal.row.1 = sGlobal.row.2 + i1RD
sGlobal.col.1 = sGlobal.col.2 + i1CD
sGlobal.rd.1 = i1RD
sGlobal.cd.1 = i1CD
sGlobal.x.1 = 'DB'x
/* Initialize Sprite # 1 with "Where I've been" info */
if sGlobal.fRetain = 'Y' then
do
sI = sGlobal.xTrailer
end
else
do
sI = sGlobal.sInitChar
end
do i = 1 to 3
j = i + 1
sGlobal.p.1.i = sI','sGlobal.row.j','sGlobal.col.j
end
/* Determine direction of sprite # 2*/
if sGlobal.i2Row > 5 then /* Bottom part of display */
do
i2RD = -1
end
else
do
i2RD = +1
end
if sGlobal.i2Col > 5 then /* Bottom part of display */
do
i2CD = -1
end
else
do
i2CD = +1
end
/* Initialize Sprite # 1 */
sGlobal.row.8 = sGlobal.i2Row
sGlobal.col.8 = sGlobal.i2Col
sGlobal.rd.8 = i2RD
sGlobal.cd.8 = i2CD
sGlobal.x.8 = 'B0'x
sGlobal.row.7 = sGlobal.row.8 + i2RD
sGlobal.col.7 = sGlobal.col.8 + i2CD
sGlobal.rd.7 = i2RD
sGlobal.cd.7 = i2CD
sGlobal.x.7 = 'B1'x
sGlobal.row.6 = sGlobal.row.7 + i2RD
sGlobal.col.6 = sGlobal.col.7 + i2CD
sGlobal.rd.6 = i2RD
sGlobal.cd.6 = i2CD
sGlobal.x.6 = 'B2'x
sGlobal.row.5 = sGlobal.row.6 + i2RD
sGlobal.col.5 = sGlobal.col.6 + i2CD
sGlobal.rd.5 = i2RD
sGlobal.cd.5 = i2CD
sGlobal.x.5 = 'DB'x
/* Initialize Sprite # 1 with "Where I've been" info */
if sGlobal.fRetain = 'Y' then
do
sI = sGlobal.xTrailer
end
else
do
sI = sGlobal.sInitChar
end
do i = 1 to 3
j = i + 5
sGlobal.p.5.i = sI','sGlobal.row.j','sGlobal.col.j
end
/* Get the starting time for "I'm Home!" and start "Collision" timer*/
sGlobal.sStartTime = TIME('S')
iESecs = TIME('R')
do FOREVER
/* Always create sprites in lower to higher layers. */
Call rDoBuildRow(8) /* Sprite # 2 */
Call rDoBuildRow(4) /* Sprite # 1 */
Call rDoBuildRow(7) /* Sprite # 2 */
Call rDoBuildRow(3) /* Sprite # 1 */
Call rDoBuildRow(6) /* Sprite # 2 */
Call rDoBuildRow(2) /* Sprite # 1 */
Call rDoBuildRow(5) /* Sprite # 2 */
Call rDoBuildRow(1) /* Sprite # 1 */
/* Display rows where sprite # 1 lives */
akey = rxPDDisplay(sGlobal.sBid,'PANEL'RIGHT(sGlobal.row.1,3,'0'))
/* If sprite # 2 is on a different row, display rows where it lives */
/* This was done just for speed but most folks won't know the */
/* difference because the "if" statement consumes time itself.*/
/* Also, except in those cases where someone starts both sprites */
/* on the same row where they end up going in the same direction,*/
/* usually the sprites are on different rows 24/25 % of the time.*/
if sGlobal.row.1 <> sGlobal.row.5 then
do
akey = rxPDDisplay(sGlobal.sBid,'PANEL'RIGHT(sGlobal.row.5,3,'0'))
end
/* Flush the composite display to the screen */
akey = rxPDDisplay(sGlobal.sBid,'PANEL999')
/* Did we had a collision? */
if sGlobal.fCollision = 'Y' then
do
/* Yes, get the elapsed time. */
iESecs = TIME('E') /* Elapsed time since */
/* If we are being noisy then beep */
if sGlobal.fBeepHeads = 'Y'then
do
Call rSiren 1, 0, 'U'
Call rSiren 1, 0, 'D'
end
sGlobal.fCollision = 'N'
/* If asked, popup a panel stating where we collided */
if sGlobal.fCollide = 'Y' then
do
svid = rxPDSaveScreen(sGlobal.sBid)
akey = rxPDDisplay(sGlobal.sBid,'TIME003')
rc = rxPDRestoreScreen(sGlobal.sBid,svid)
if akey = ZESC then
do
return 1
end
end
iESecs = TIME('R') /* Restart for this iteration */
end
/* Are we back home? */
if sGlobal.fBackHome = 'Y' then
do
/* Yes, if we are being noisy then beep */
if sGlobal.fBeepHome = 'Y'then
do
Call rSiren 5, 0, 'U'
Call rSiren 5, 0, 'D'
Call rSiren 5, 0, 'U'
Call rSiren 5, 0, 'D'
end
sGlobal.fBackHome = 'N'
/* If asked, popup a panel stating "We're Back!" */
if sGlobal.fHome = 'Y' then
do
iESecs = (TIME('S') - sGlobal.sStartTime) / 60
svid = rxPDSaveScreen(sGlobal.sBid)
akey = rxPDDisplay(sGlobal.sBid,'HOME001')
rc = rxPDRestoreScreen(sGlobal.sBid,svid)
if akey = ZESC then
do
return 1
end
end
sGlobal.sStartTime = TIME('S')
end
/* Move each pieces parts to its next position */
Call rDoUpdateRow(8)
Call rDoUpdateRow(4)
Call rDoUpdateRow(7)
Call rDoUpdateRow(3)
Call rDoUpdateRow(6)
Call rDoUpdateRow(2)
Call rDoUpdateRow(5)
Call rDoUpdateRow(1)
end /*do FOREVER */
return 0;
rDoBuildRow: Procedure Expose sRow. sGlobal.
parse arg iItem
iR = sGlobal.row.iItem
iC = sGlobal.col.iItem
sX = sGlobal.x.iItem
/* Are we moving the head of a snake? */
if iItem = 5 | iItem = 1 then
do
/* Yes, get the character at our target position */
sC = SUBSTR(sRow.iR,iC,1)
/* Are we leaving a trail? */
if sGlobal.fRetain = 'Y' then
do
Call rDoRetain iItem, iR, iC, sC
end
/* Did we collide with the other snake? */
if sC = sX then
do
sGlobal.fCollision = 'Y'
end
else
do
/* If we are stepping on a trail and if noisy then beep */
if sC <> sGlobal.sInitChar then
do
if sGlobal.fBeepTrail = 'Y' then
do
Call BEEP 512,15
end
end
end
sGlobal.fBackHome = 'N'
/* If sprite # 1 and back home, flag it */
if iItem = 1 then
do
if iR = sGlobal.i1Row & iC = sGlobal.i1Col then
do
sGlobal.fBackHome = 'Y'
end
end
end
/* Construct the row */
if iC = 1 then
do
sRow.iR = sX||RIGHT(sRow.iR,sGlobal.iMaxC-1)
end
else
do
sRow.iR = LEFT(sRow.iR,iC-1)||sX||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
end
return 0;
rDoRetain: Procedure Expose sRow. sGlobal.
parse arg iItem, iR, iC, sC
/* Is the stepped on character the initialization character? */
if sC = sGlobal.sInitChar then
do
/* Yes, then we will leave the trailer character behind. */
sC = sGlobal.xTrailer
end
else
do
/* No, then we might leave the initialization character behind. */
sC = sGlobal.sInitChar
if iItem = 1 then /* Sprite # 1 stepped on # 2? */
do
i1 = 5 /* Test Sprite # 2 first */
i2 = 1 /* Test Sprite # 1 second */
end
else /* Sprite # 2 stepped on # 1? */
do
i1 = 1 /* Test Sprite # 1 first */
i2 = 5 /* Test Sprite # 2 second */
end
/* We might be stepping on the other sprite or ourselves so we */
/* will try to find this row/col in either sprite. */
/* If we do, then we need to invert what was there previously */
do j = 1 to 4
parse var sGlobal.p.i1.j sTstCH','sTstRow','sTstCol
if sTstRow = iR & sTstCol = iC then
do
if sTstCH = sGlobal.sInitChar then
do
sC = sGlobal.xTrailer
end
else
do
sC = sGlobal.sInitChar
end
LEAVE j
end
parse var sGlobal.p.i2.j sTstCH','sTstRow','sTstCol
if sTstRow = iR & sTstCol = iC then
do
if sTstCH = sGlobal.sInitChar then
do
sC = sGlobal.xTrailer
end
else
do
sC = sGlobal.sInitChar
end
LEAVE j
end
end /*do j = 1 to 4*/
end
/* Push the "Trail" characters thru the stack */
i = 3
j = 4
do i
sGlobal.p.iItem.j = sGlobal.p.iItem.i
i = i - 1
j = j - 1
end
sGlobal.p.iItem.1 = sC','iR','iC
return 0;
rDoUpdateRow: Procedure Expose sRow. sGlobal.
parse arg iItem
iR = sGlobal.row.iItem
iRD= sGlobal.rd.iITem
iC = sGlobal.col.iItem
iCD= sGlobal.cd.iITem
/* If we are the trailing part of a sprite then we need to either */
/* leave behind the initialization character or in the case where */
/* we are leaving a trail, whatever the inverted state character */
/* for this position must be. */
if iItem = 4 | iItem = 8 then
do
sI = sGlobal.sInitChar
if sGlobal.fRetain = 'Y' then
do
if iItem = 4 then
do
i = 1
end
else
do
i = 5
end
parse var sGlobal.p.i.4 sI','sTstRow','sTstCol
end
if iC = 1 then
do
sRow.iR = sI||RIGHT(sRow.iR,sGlobal.iMaxC-1)
end
else
do
sRow.iR = LEFT(sRow.iR,iC-1)||sI||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
end
end
/* Compute the next row. If we hit a wall then beep (maybe) and */
/* reverse the direction. */
iR = iR + iRD
if iR < 1 then
do
if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
do
Call BEEP 1024, 25
end
iR = 2
iRD = +1
end
else
if iR > sGlobal.iMaxR then
do
if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
do
Call BEEP 1024, 25
end
iR = sGlobal.iMaxR - 1
iRD = -1
end
/* Compute the next column. If we hit a wall then beep (maybe) and */
/* reverse the direction. */
iC = iC + iCD
if iC < 1 then
do
if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
do
Call BEEP 1024, 25
end
iC = 2
iCD = +1
end
else
if iC > sGlobal.iMaxC then
do
if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
do
Call BEEP 1024, 25
end
iC = sGlobal.iMaxC - 1
iCD = -1
end
sGlobal.row.iItem = iR
sGlobal.rd.iITem = iRD
sGlobal.col.iItem = iC
sGlobal.cd.iITem = iCD
return 0;
HaltExit:
if fInit = 'Y' then
do
rc = rxPDTerm(sGlobal.sBid)
end
Call BEEP 882, 40
Call BEEP 882, 40
say ''
say 'SNAKE2 processing halted by request;'
exit 0
ErrorExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'SNAKE2 processing failed due to unknown error;'
exit 24
FailureExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'SNAKE2 processing failed due to unknown failure;'
exit 32
SyntaxExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'SNAKE2 processing failed due to syntax error;'
exit 64
rParseParms:
parse arg p1
do Forever
w1 = word(p1,1)
parse var w1 with "/" f1 ":" v1
select
when (w1 = '') then
do
return 0
end
when TRANSLATE(w1) = '/DEBUG' then
do
fDebug='Y'
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'D' then
do
fDebug = TRANSLATE(v1)
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = '?' then
do
fDispStax='Y'
fDispHelp='N'
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'H' then
do
fDispStax='N'
fDispHelp='Y'
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'T' then
do
fRetainQ='Y'
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'PC' then
do
v1 = TRANSLATE(v1)
fCollideQ = v1
if v1 = '' then
do
fCollideQ = 'Y'
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'PH' then
do
v1 = TRANSLATE(v1)
fHomeQ = v1
if v1 = '' then
do
fHomeQ = 'Y'
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'SB' then
do
v1 = TRANSLATE(v1)
fBeepTrailQ = v1
if v1 = '' then
do
fBeepTrailQ = 'Y'
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'CB' then
do
v1 = TRANSLATE(v1)
fBeepHeadsQ = v1
if v1 = '' then
do
fBeepHeadsQ = 'Y'
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'WB' then
do
v1 = TRANSLATE(v1)
fBeepWallsQ = v1
if v1 = '' then
do
fBeepWallsQ = 'Y'
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'HB' then
do
v1 = TRANSLATE(v1)
fBeepHomeQ = v1
if v1 = '' then
do
fBeepHomeQ = 'Y'
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'I' then
do
fInitCHQ='Y'
sInitCH =v1
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'R1' then
do
fInitRow1Q ='Y'
iInitRow1 =v1
if DATATYPE(iInitRow1) <> 'NUM' then
do
Call rSiren 8, 1
say 'SNAKE2 - Invalid ROW specified; Value "'v1'" not numeric;'
CALL rDispSyntax 0 8
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'C1' then
do
fInitCol1Q ='Y'
iInitCol1 =v1
if DATATYPE(iInitCol1) <> 'NUM' then
do
Call rSiren 8, 1
say 'SNAKE2 - Invalid COL specified; Value "'v1'" not numeric;'
CALL rDispSyntax 0 8
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'R2' then
do
fInitRow2Q ='Y'
iInitRow2 =v1
if DATATYPE(iInitRow2) <> 'NUM' then
do
Call rSiren 8, 1
say 'SNAKE2 - Invalid ROW specified; Value "'v1'" not numeric;'
CALL rDispSyntax 0 8
end
p1 = SUBWORD(p1,2)
end
when TRANSLATE(f1) = 'C2' then
do
fInitCol2Q ='Y'
iInitCol2 =v1
if DATATYPE(iInitCol2) <> 'NUM' then
do
Call rSiren 8, 1
say 'SNAKE2 - Invalid COL specified; Value "'v1'" not numeric;'
CALL rDispSyntax 0 8
end
p1 = SUBWORD(p1,2)
end
otherwise
do
Call rSiren 8, 1
say 'SNAKE2 - Invalid parm specified; Parm "'w1'" unknown;'
CALL rDispSyntax 0 8
end
end
end
return 0
rDispSyntax: Procedure
parse upper arg iHelp iExit
say ' Syntax : SNAKE2 {<options>} '
say ' SNAKE2 {/?|/h}'
if iHelp > 0 then
do
CALL rDispHelp
end
exit iExit
rDispHelp: Procedure
say ' Options : /? - Display command syntax.'
say ' /h - Display this help info.'
say ' /t - Leave a trail where snake has traveled.'
say ' /pc - Pause when there is a collision.'
say ' /ph - Pause when the snakes get home.'
say ' /sb - NOISY! Beep when step on a snake''s trail.'
say ' /cb - NOISY! Beep when snakes collide.'
say ' /wb - NOISY! Beep when snakes bump into walls.'
say ' /hb - NOISY! Beep when snakes get back home.'
say ' /i:char - Character to initialize display with.'
say ' /r1:row - Starting row for 1st snake.'
say ' /c1:col - Starting column for 1st snake.'
say ' /r2:row - Starting row for 2nd snake.'
say ' /c2:col - Starting column for 2nd snake.'
say ' Examples:'
say ' SNAKE2 /h'
say ' '
say ' SNAKE2 /t /wb /ph /hb /pc /cb /c2:1'
return ''
/* rSiren: does the siren bit by running the scale based upon a */
/* frequency specified by the caller. */
rSiren: Procedure
Parse Arg freq, cycle, fStyle
note.1 = 262 * freq /* middle C */
note.2 = 294 * freq /* D */
note.3 = 330 * freq /* E */
note.4 = 349 * freq /* F */
note.5 = 392 * freq /* G */
note.6 = 440 * freq /* A */
note.7 = 494 * freq /* B */
note.8 = 524 * freq /* C */
select
when fStyle = 'U' then
do
j = 1
do 8
call beep note.j,25 /* hold each note for a 1/400 second */
j = j + 1
end /*8*/
end
when fStyle = 'D' then
do
j = 8
do 8
call beep note.j,25 /* hold each note for a 1/400 second */
j = j - 1
end /*8*/
end
otherwise
do
do j = 1 to cycle
call beep note.8,250 /* hold each note for a 1/4 second */
call beep note.1,250 /* hold each note for a 1/4 second */
end j
end
end /*select*/
Return
rLoadFuncs:
parse arg sREP, sDll, sRtn
rxrc = RxFuncAdd(sREP, sDll, sRtn)
signal on syntax name xLoadFuncs
interpret 'Call 'sRtn
return 0
xLoadFuncs:
return 127